home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 7: Sunsite / Linux Cubed Series 7 - Sunsite Vol 1.iso / system / printing / ljetmgr2.4-b / ljetmgr2 / SW / lib / libtxHtml5.2.tsl < prev    next >
Text File  |  1996-07-01  |  8KB  |  209 lines
  1. # RQ txText 5
  2. # RQ html 1
  3. # RQ config 10
  4. # RQ msg 2
  5. # RQ txStdDialog 5
  6. # RQ txList 5
  7. # RQ txPrint 1
  8. # RQ txDlgShell 5
  9. # RQ htmlforms 1
  10. # +END
  11. # RCS:    $Id: html.tcl,v 1.2 1996/05/12 14:52:37 risc Exp $
  12. proc txHtml_Init { args } {Require msg 2
  13. Require config 10
  14. option add *TxHtml.height 40 widgetDefault
  15. option add *TxHtml.width 70 widgetDefault
  16. catch {ConfigRead [Locate msg html] "Msg def"}
  17. Require html 1
  18. global HMtag_map
  19. array set HMtag_map {h1     {size 18 weight bold}
  20. h2     {size 16 weight bold}        
  21. h3     {size 14 weight bold}    
  22. h4     {size 14}
  23. h5     {size 14}}
  24. set HMtag_map(hmstart) {family Helvetica   
  25. weight medium   
  26. style r   
  27. size 14
  28. Tcenter ""   
  29. Tlink ""   
  30. Tnowrap ""   
  31. Tunderline ""   
  32. list list
  33. fill 1   
  34. indent "" 
  35. counter 0 
  36. adjust 0}
  37. catch {rename HMlink_callback {}}
  38. catch {rename HMset_image {}}
  39. catch {rename HMlink_found {}}
  40. rename txHtml::link_callback HMlink_callback
  41. rename txHtml::set_image HMset_image
  42. rename txHtml::link_found HMlink_found}
  43. set HMloaded 0
  44. Require txDlgShell 5
  45. tixWidgetClass txHtml {-classname TxHtml
  46. -superclass txDlgShell
  47. -flag {-pagecmd
  48. -urlcmd
  49. -submitcmd
  50. -forms
  51. -state
  52. -showbook}
  53. -method {set
  54. get}
  55. -configspec {{-pagecmd pageCmd PageCmd "txHtml::getpage %w %f"}
  56. {-urlcmd urlCmd UrlCmd "txHtml::geturl %w %p"}
  57. {-submitcmd submitCmd SubmitCmd "txHtml::SubmitForm %t %p %q"}
  58. {-forms forms Forms 0}
  59. {-state state State "view"}
  60. {-showbook showBook ShowBook 0}}}
  61. proc txHtml::InitWidgetRec { w } {upvar \#0 $w data
  62. tixChainMethod $w InitWidgetRec
  63. set data(booktxt) {}
  64. set data(bookref) {}
  65. set data(url) {}
  66. set data(bookindex) -1}
  67. proc txHtml::ConstructWidget { w } {upvar #0 $w data
  68. txHtml::config-forms $w $data(-forms)
  69. tixChainMethod $w ConstructWidget
  70. Require txText 5
  71. set data(w:html) [txText [$w subwidget frame].html -express 1 -state view -wrap word -width $data(-width) -height $data(-height) ]
  72. set express [$data(w:html) subwidget express]
  73. set data(w:express) $express
  74. Require msg 2
  75. $express add left back -text [Msg def Html Back "Last"] -underline [Msg def Html Backu 0] -image [Msg def Html Backi ""] -command "txHtml:Bookmark $w back"
  76. $express add left forw -text [Msg def Html Fore "Next"] -underline [Msg def Html Foreu 0] -image [Msg def Html Forei ""] -command "txHtml:Bookmark $w forw"
  77. $express add left home -text [Msg def Html Home "Home"] -underline [Msg def Html Homeu 0] -image [Msg def Html Homei ""] -command "txHtml:Bookmark $w home"
  78. $express add left mark -text [Msg def Html Mark "Bookmark"] -underline [Msg def Html Marku 0] -image [Msg def Html Marki ""] -command "txHtml:Bookmark $w mark"
  79. $express add right end -text [Msg def Html Close "Close"] -underline [Msg def Html Closeu 0] -image [Msg def Html Closei ""] -command "destroy $w"
  80. set pr [$express add right print -text [Msg def Html Print "Print"] -underline [Msg def Html Printu 0] -image [Msg def Html Printi ""] ]
  81. $pr config -command "txHtml:Print $w $pr"
  82. pack $data(w:html) -fill both -expand y -padx 5 -pady 5
  83. set data(w:text) [$data(w:html) subwidget text]
  84. tixSetMegaWidget $data(w:text) $w
  85. HMinit_win $data(w:text)}
  86. proc txHtml::Destructor { w } {upvar \#0 $w data
  87. upvar \#0 HM$data(w:text) html
  88. catch {unset html}
  89. tixUnsetMegaWidget $data(w:text)
  90. tixChainMethod $w Destructor}
  91. proc txHtml::config-forms { w val } {if { $val } {Require htmlforms 1
  92. catch {rename HMsubmit_form txHtml:SubmitForm
  93. rename txHtml::submit HMsubmit_form}}}
  94. proc txHtml::show { w } {upvar \#0 $w data
  95. tixChainMethod $w show
  96. update
  97. if { $data(-showbook)} {txHtml:Bookmark $w mark}}
  98. proc txHtml::set { w page } {upvar \#0 $w data
  99. global HM.text Url
  100. global Running message
  101. set fragment ""
  102. regexp {([^\#]*)\#(.+)} "$page" dummy page fragment
  103. if {$page == ""} {HMgoto $data(w:text) "$fragment"
  104. if { $fragment!="" } {txHtml:Bookmark $w update "$data(url)\#$fragment"} else {txHtml:Bookmark $w update "$data(url)"}
  105. return}
  106. set cmd [Replace $data(-urlcmd) [list "%w=$w" "%p=$page"]]
  107. set fname [eval $cmd]
  108. if { $fname==""} {set fname $page}
  109. if { $data(url)!=$fname } {HMreset_win $data(w:text)
  110. set Running busy
  111. update idletasks
  112. set data(url) $fname
  113. set cmd [Replace $data(-pagecmd) [list "%w=$w" "%p=$page" "%f=$fname"]]
  114. set txt [eval $cmd]
  115. catch {HMparse_html $txt "HMrender $data(w:text)"}}
  116. catch {HMgoto $data(w:text) $fragment
  117. if { $fragment!="" } {txHtml:Bookmark $w update "$data(url)\#$fragment"} else {txHtml:Bookmark $w update "$data(url)"}}}
  118. proc txHtml::get { w } {upvar \#0 $w data
  119. return $data(url)}
  120. proc txHtml::geturl { w file} {upvar \#0 $w data
  121. if { [file readable $file] } {return $file}
  122. set fname [file dirname $data(url)]/[file tail $file]
  123. if { [file readable $fname] } {return $fname}
  124. return {}}
  125. proc txHtml::getpage { w file} {if {[catch {set fd [open $file]} msg]} {return [Msg def Html-Error FileNotFound "<title>Unreadable: $file</title> \n <h3>Error: cannot read page '$file'</h3><p>\n%e" "%f=$file" "%e=$msg" ]}
  126. set result [read $fd]
  127. close $fd
  128. return $result}
  129. proc txHtml::link_callback { win href } {update
  130. set w [winfo toplevel $win]
  131. txHtml::set $w $href}
  132. proc txHtml::link_found { win href text} {set w [winfo toplevel $win]
  133. upvar \#0 $w data
  134. upvar 1 $text txt
  135. if { [regexp {^\#} $href] } {set href "$data(url)$href"}
  136. txHtml:Bookmark $w add $href txt}
  137. proc txHtml::set_image { win handle src } {set w [winfo toplevel $win]
  138. upvar \#0 $w data
  139. if {[string match /* $src]} {set image $src} else {set image [file dirname $data(url)]/$src}
  140. update
  141. if {[string first " $image " " [image names] "] >= 0} {HMgot_image $handle $image} else {switch [file extension $image] {".xbm" {set type bitmap}
  142. ".xpm" {set type pixmap}
  143. default {set type photo}}
  144. catch {image create $type $image -file $image} image
  145. HMgot_image $handle $image}}
  146. proc txHtml::submit { win param query} {set w [tixGetMegaWidget $win]
  147. upvar \#0 $w data
  148. set cmd [Replace $data(-submitcmd) [list "%w=$w" "%t=$win" "%p=[list $param]" "%q=[list $query]" ]]
  149. eval $cmd}
  150. proc txHtml:Print { w pr } {set url [$w get]
  151. set name [file tail $url]
  152. if {[winfo exists .helppr] } {bell
  153. return}
  154. Require txPrint 1
  155. txPrint .helppr -parent $pr -doctitle $name -doctype html -command "txHtml:DoPrint $url"}
  156. proc txHtml:DoPrint { url } {set date [clock format [clock seconds] -format "%Y/%m/%d-%H:%M"]
  157. set cmd [Replace [Cfg get Printer Command] [list "%f=$url" "%d=[Cfg get Printer Document]" "%t=[Cfg get Printer Format]" "%c=[Cfg get Printer Copies]" "%u=[Cfg get Printer User]" "%T=$date" ]]
  158. eval exec $cmd}
  159. proc txHtml:Bookmark { w typ args} {upvar \#0 $w data
  160. switch $typ {add {lset $args href txt
  161. set cmd [Replace $data(-urlcmd) [list "%w=$w" "%p=$href"]]
  162. set fname [eval $cmd]
  163. if { $fname==""} {set fname $href}
  164. if { [lsearch -exact $data(bookref) $fname]<0 } {lappend data(bookref) $fname
  165. upvar $txt text
  166. lappend data(booktxt) "$text"}}
  167. back {incr data(bookindex) -1
  168. if { $data(bookindex)<0 } {set data(bookindex) 0
  169. bell}
  170. txHtml::set $w [lindex $data(bookref) $data(bookindex)]}
  171. forw {incr data(bookindex) 
  172. if { $data(bookindex)>=[llength $data(bookref)] } {set data(bookindex) [expr [llength $data(bookref)] -1]
  173. bell}
  174. txHtml::set $w [lindex $data(bookref) $data(bookindex)]}
  175. home {txHtml::set $w [lindex $data(bookref) 0]}
  176. select {if { ![winfo exists $w.book] } {return}
  177. set lbox [lindex $args 0]
  178. set idx [lindex [$lbox curselection] 0]
  179. try {if { $idx>=0 } {set data(bookindex) $idx} else {bell}
  180. txHtml::set $w [lindex $data(bookref) $data(bookindex)]} {bell}}
  181. update {if { ![winfo exists $w.book] } {return}
  182. set href [lindex $args 0]
  183. set lbox [$w.book subwidget frame].lb
  184. $lbox delete 0 end
  185. set n 0
  186. foreach i $data(booktxt) j $data(bookref) {$lbox insert end $i
  187. if { $j==$href } {$lbox selection set $n $n
  188. $lbox see $n
  189. set data(bookindex) $n}
  190. incr n}}
  191. mark {txHtml:BookList $w}}}
  192. proc txHtml:BookList { w } {upvar \#0 $w data
  193. if { [winfo exists $w.book] } {$w.book show
  194. return}
  195. Require txStdDialog 5
  196. txStdDialog $w.book -title [Msg def Html Book "Bookmarks"]
  197. set f [$w.book subwidget frame]
  198. Require txList 5
  199. txList $f.lb -selectmode browse -command "txHtml:Bookmark $w select $f.lb" -height 5 
  200. pack $f.lb -padx 5 -pady 5 -fill both -expand y
  201. $f.lb delete 0 end
  202. txHtml:Bookmark $w update {}
  203. $w.book config -okcmd "wm withdraw $w.book; txHtml:Bookmark $w select $f.lb" -cancelcmd "wm withdraw $w.book" -applycmd "txHtml:Bookmark $w select $f.lb"
  204. set x [winfo pointerx $w]
  205. set y [winfo pointery $w]
  206. $w.book setpos $x $y
  207. $w.book show}
  208. # +EOF
  209.